MSDS 6306 - Case Study 02

I. Project Description

• DDSAnalytics is an analytics company that specializes in talent management solutions for Fortune 100 companies. Talent management is defined as the iterative process of developing and retaining employees. It may include workforce planning, employee training programs, identifying high-potential employees and reducing/preventing voluntary employee turnover (attrition). To gain a competitive edge over its competition, DDSAnalytics is planning to leverage data science for talent management. The executive leadership has identified predicting employee turnover as its first application of data science for talent management. Before the business green lights the project, they have tasked your data science team to conduct an analysis of existing employee data.

• Here I will do a data analysis on a given dataset CaseStudy2-data.csv to identify factors that lead to attrition. I will identify the top three factors that contribute to turnover (backed up by evidence provided by analysis). There may or may not be a need to create derived attributes/variables/features. The business is also interested in learning about any job role specific trends that may exist in the data set (e.g., “Data Scientists have the highest job satisfaction”). I also provide any other interesting trends and observations from the analysis. The analysis will be backed up by robust experimentation and appropriate visualization. Experiments and analysis are conducted in R. I will also build a model to predict attrition.

II. Preparing Steps

1. Used Libraries:

library(tidyverse) #The "tidyverse" collects some of the most versatile R packages: ggplot2, dplyr, tidyr, readr, purrr, and tibble. The packages work in harmony to clean, process, model, and visualize data.
library(skimr) #for data summary - so sweet and I like a lot this library
library(mice) #package provides a nice function md.pattern() to get a better understanding of the pattern of missing data
library(VIM) #more helpful visual representation can be obtained using the VIM package for agrr
library(naniar) #https://cran.r-project.org/web/packages/naniar/vignettes/getting-started-w-naniar.html (for gg_mis_var) (Missing values)
library(mlbench) #collection of artificial and real-world machine learning benchmark problems, including, e.g., several data sets from the UCI repository. (also has BostonHousing)
library(caret)
library(mlr)
library(tidyverse)
library(ggthemes)
library(gplots)
library(randomForest)
library(corrplot)
library(kableExtra)
library(plotly)
library(GGally) #for ggpairs
library(Boruta) #for Automated EDA later
library(readxl) #read excel
library(e1071) #Naive Bayes

2. Loading the data:

rawdata0 <- read.csv("CaseStudy2-data.csv")
head(rawdata0)

##   ID Age Attrition    BusinessTravel DailyRate             Department
## 1  1  32        No     Travel_Rarely       117                  Sales
## 2  2  40        No     Travel_Rarely      1308 Research & Development
## 3  3  35        No Travel_Frequently       200 Research & Development
## 4  4  32        No     Travel_Rarely       801                  Sales
## 5  5  24        No Travel_Frequently       567 Research & Development
## 6  6  27        No Travel_Frequently       294 Research & Development
##   DistanceFromHome Education   EducationField EmployeeCount EmployeeNumber
## 1               13         4    Life Sciences             1            859
## 2               14         3          Medical             1           1128
## 3               18         2    Life Sciences             1           1412
## 4                1         4        Marketing             1           2016
## 5                2         1 Technical Degree             1           1646
## 6               10         2    Life Sciences             1            733
##   EnvironmentSatisfaction Gender HourlyRate JobInvolvement JobLevel
## 1                       2   Male         73              3        2
## 2                       3   Male         44              2        5
## 3                       3   Male         60              3        3
## 4                       3 Female         48              3        3
## 5                       1 Female         32              3        1
## 6                       4   Male         32              3        3
##                  JobRole JobSatisfaction MaritalStatus MonthlyIncome
## 1        Sales Executive               4      Divorced          4403
## 2      Research Director               3        Single         19626
## 3 Manufacturing Director               4        Single          9362
## 4        Sales Executive               4       Married         10422
## 5     Research Scientist               4        Single          3760
## 6 Manufacturing Director               1      Divorced          8793
##   MonthlyRate NumCompaniesWorked Over18 OverTime PercentSalaryHike
## 1        9250                  2      Y       No                11
## 2       17544                  1      Y       No                14
## 3       19944                  2      Y       No                11
## 4       24032                  1      Y       No                19
## 5       17218                  1      Y      Yes                13
## 6        4809                  1      Y       No                21
##   PerformanceRating RelationshipSatisfaction StandardHours
## 1                 3                        3            80
## 2                 3                        1            80
## 3                 3                        3            80
## 4                 3                        3            80
## 5                 3                        3            80
## 6                 4                        3            80
##   StockOptionLevel TotalWorkingYears TrainingTimesLastYear WorkLifeBalance
## 1                1                 8                     3               2
## 2                0                21                     2               4
## 3                0                10                     2               3
## 4                2                14                     3               3
## 5                0                 6                     2               3
## 6                2                 9                     4               2
##   YearsAtCompany YearsInCurrentRole YearsSinceLastPromotion
## 1              5                  2                       0
## 2             20                  7                       4
## 3              2                  2                       2
## 4             14                 10                       5
## 5              6                  3                       1
## 6              9                  7                       1
##   YearsWithCurrManager
## 1                    3
## 2                    9
## 3                    2
## 4                    7
## 5                    3
## 6                    7

view(rawdata0) #There are 870 entries, 36 total columns
length(rawdata0) #[1] 36

## [1] 36

skim(rawdata0) #so sweet 0- for data summary

Data summary

Name	rawdata0
Number of rows	870
Number of columns	36
_______________________
Column type frequency:
factor	9
numeric	27
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
Attrition	0	1	FALSE	2	No: 730, Yes: 140
BusinessTravel	0	1	FALSE	3	Tra: 618, Tra: 158, Non: 94
Department	0	1	FALSE	3	Res: 562, Sal: 273, Hum: 35
EducationField	0	1	FALSE	6	Lif: 358, Med: 270, Mar: 100, Tec: 75
Gender	0	1	FALSE	2	Mal: 516, Fem: 354
JobRole	0	1	FALSE	9	Sal: 200, Res: 172, Lab: 153, Man: 87
MaritalStatus	0	1	FALSE	3	Mar: 410, Sin: 269, Div: 191
Over18	0	1	FALSE	1	Y: 870
OverTime	0	1	FALSE	2	No: 618, Yes: 252

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
ID	0	1	435.50	251.29	1	218.25	435.5	652.75	870	▇▇▇▇▇
Age	0	1	36.83	8.93	18	30.00	35.0	43.00	60	▂▇▇▃▂
DailyRate	0	1	815.23	401.12	103	472.50	817.5	1165.75	1499	▇▇▇▇▇
DistanceFromHome	0	1	9.34	8.14	1	2.00	7.0	14.00	29	▇▅▂▂▂
Education	0	1	2.90	1.02	1	2.00	3.0	4.00	5	▂▅▇▆▁
EmployeeCount	0	1	1.00	0.00	1	1.00	1.0	1.00	1	▁▁▇▁▁
EmployeeNumber	0	1	1029.83	604.79	1	477.25	1039.0	1561.50	2064	▇▇▇▇▇
EnvironmentSatisfaction	0	1	2.70	1.10	1	2.00	3.0	4.00	4	▅▆▁▇▇
HourlyRate	0	1	65.61	20.13	30	48.00	66.0	83.00	100	▇▇▆▇▇
JobInvolvement	0	1	2.72	0.70	1	2.00	3.0	3.00	4	▁▃▁▇▁
JobLevel	0	1	2.04	1.09	1	1.00	2.0	3.00	5	▇▇▃▂▁
JobSatisfaction	0	1	2.71	1.11	1	2.00	3.0	4.00	4	▅▅▁▇▇
MonthlyIncome	0	1	6390.26	4597.70	1081	2839.50	4945.5	8182.00	19999	▇▅▂▁▁
MonthlyRate	0	1	14325.62	7108.38	2094	8092.00	14074.5	20456.25	26997	▇▇▇▇▇
NumCompaniesWorked	0	1	2.73	2.52	0	1.00	2.0	4.00	9	▇▃▂▂▁
PercentSalaryHike	0	1	15.20	3.68	11	12.00	14.0	18.00	25	▇▅▃▂▁
PerformanceRating	0	1	3.15	0.36	3	3.00	3.0	3.00	4	▇▁▁▁▂
RelationshipSatisfaction	0	1	2.71	1.10	1	2.00	3.0	4.00	4	▅▅▁▇▇
StandardHours	0	1	80.00	0.00	80	80.00	80.0	80.00	80	▁▁▇▁▁
StockOptionLevel	0	1	0.78	0.86	0	0.00	1.0	1.00	3	▇▇▁▂▁
TotalWorkingYears	0	1	11.05	7.51	0	6.00	10.0	15.00	40	▇▇▂▁▁
TrainingTimesLastYear	0	1	2.83	1.27	0	2.00	3.0	3.00	6	▂▇▇▂▃
WorkLifeBalance	0	1	2.78	0.71	1	2.00	3.0	3.00	4	▁▃▁▇▂
YearsAtCompany	0	1	6.96	6.02	0	3.00	5.0	10.00	40	▇▃▁▁▁
YearsInCurrentRole	0	1	4.20	3.64	0	2.00	3.0	7.00	18	▇▃▂▁▁
YearsSinceLastPromotion	0	1	2.17	3.19	0	0.00	1.0	3.00	15	▇▁▁▁▁
YearsWithCurrManager	0	1	4.14	3.57	0	2.00	3.0	7.00	17	▇▂▅▁▁

rawdata <- rawdata0

Then the dataset has 870 observations and 36 variables.

3. Checking for missing data:

Actually by skim(rawdata), we can see there is no missing data in the dataset. However, I will introduce some other codes that can be used to check for missing data as a reference. We only need to run one code to check for missing data.

md.pattern(rawdata)

##  /\     /\
## {  `---'  }
## {  O   O  }
## ==>  V <==  No need for mice. This data set is completely observed.
##  \  \|/  /
##   `-----'

##     ID Age Attrition BusinessTravel DailyRate Department DistanceFromHome
## 870  1   1         1              1         1          1                1
##      0   0         0              0         0          0                0
##     Education EducationField EmployeeCount EmployeeNumber
## 870         1              1             1              1
##             0              0             0              0
##     EnvironmentSatisfaction Gender HourlyRate JobInvolvement JobLevel
## 870                       1      1          1              1        1
##                           0      0          0              0        0
##     JobRole JobSatisfaction MaritalStatus MonthlyIncome MonthlyRate
## 870       1               1             1             1           1
##           0               0             0             0           0
##     NumCompaniesWorked Over18 OverTime PercentSalaryHike PerformanceRating
## 870                  1      1        1                 1                 1
##                      0      0        0                 0                 0
##     RelationshipSatisfaction StandardHours StockOptionLevel
## 870                        1             1                1
##                            0             0                0
##     TotalWorkingYears TrainingTimesLastYear WorkLifeBalance YearsAtCompany
## 870                 1                     1               1              1
##                     0                     0               0              0
##     YearsInCurrentRole YearsSinceLastPromotion YearsWithCurrManager  
## 870                  1                       1                    1 0
##                      0                       0                    0 0

aggr_plot <- aggr(rawdata, col=c('navyblue','red'), numbers=TRUE, sortVars=TRUE, labels=names(rawdata), cex.axis=.7, gap=3, ylab=c("Histogram of missing data","Pattern"))

## 
##  Variables sorted by number of missings: 
##                  Variable Count
##                        ID     0
##                       Age     0
##                 Attrition     0
##            BusinessTravel     0
##                 DailyRate     0
##                Department     0
##          DistanceFromHome     0
##                 Education     0
##            EducationField     0
##             EmployeeCount     0
##            EmployeeNumber     0
##   EnvironmentSatisfaction     0
##                    Gender     0
##                HourlyRate     0
##            JobInvolvement     0
##                  JobLevel     0
##                   JobRole     0
##           JobSatisfaction     0
##             MaritalStatus     0
##             MonthlyIncome     0
##               MonthlyRate     0
##        NumCompaniesWorked     0
##                    Over18     0
##                  OverTime     0
##         PercentSalaryHike     0
##         PerformanceRating     0
##  RelationshipSatisfaction     0
##             StandardHours     0
##          StockOptionLevel     0
##         TotalWorkingYears     0
##     TrainingTimesLastYear     0
##           WorkLifeBalance     0
##            YearsAtCompany     0
##        YearsInCurrentRole     0
##   YearsSinceLastPromotion     0
##      YearsWithCurrManager     0

gg_miss_var(rawdata, show_pct = TRUE) + labs(title = "Percent missing of the data") + theme(legend.position = "none", plot.title = element_text(hjust = 0.5), axis.title.y = element_text(angle = 0, vjust = 1))

Then the dataset has no missing data.

4. Dropping unused columns:

We observe by skim() or view() that there are some columns without variation. Then we can drop these columns without affecting our analysis. Observing skim(), we see Over18 has all 870 observations with value Y, EmployeeCount has all 870 observations with value 1, StandardHours has all 870 observations with value 80. In addition, 18 years old is a standard working age and 80 hours/week is high (maybe per 2 weeks - employees receive paycheck per 2 weeks). Then we can drop these three columns.

drop_columns <- which(apply(rawdata, 2, function(x) (length(unique(x)) == 1)))

cols <- names(drop_columns)
rawdata <- rawdata[,-drop_columns]

#Actually, we can drop manually by another code as  rawdata <- select(rawdata, -c("Over18","EmployeeCount", "StandardHours")) . We will get the same results finally.

skim(rawdata)

Data summary

Name	rawdata
Number of rows	870
Number of columns	33
_______________________
Column type frequency:
factor	8
numeric	25
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
Attrition	0	1	FALSE	2	No: 730, Yes: 140
BusinessTravel	0	1	FALSE	3	Tra: 618, Tra: 158, Non: 94
Department	0	1	FALSE	3	Res: 562, Sal: 273, Hum: 35
EducationField	0	1	FALSE	6	Lif: 358, Med: 270, Mar: 100, Tec: 75
Gender	0	1	FALSE	2	Mal: 516, Fem: 354
JobRole	0	1	FALSE	9	Sal: 200, Res: 172, Lab: 153, Man: 87
MaritalStatus	0	1	FALSE	3	Mar: 410, Sin: 269, Div: 191
OverTime	0	1	FALSE	2	No: 618, Yes: 252

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
ID	0	1	435.50	251.29	1	218.25	435.5	652.75	870	▇▇▇▇▇
Age	0	1	36.83	8.93	18	30.00	35.0	43.00	60	▂▇▇▃▂
DailyRate	0	1	815.23	401.12	103	472.50	817.5	1165.75	1499	▇▇▇▇▇
DistanceFromHome	0	1	9.34	8.14	1	2.00	7.0	14.00	29	▇▅▂▂▂
Education	0	1	2.90	1.02	1	2.00	3.0	4.00	5	▂▅▇▆▁
EmployeeNumber	0	1	1029.83	604.79	1	477.25	1039.0	1561.50	2064	▇▇▇▇▇
EnvironmentSatisfaction	0	1	2.70	1.10	1	2.00	3.0	4.00	4	▅▆▁▇▇
HourlyRate	0	1	65.61	20.13	30	48.00	66.0	83.00	100	▇▇▆▇▇
JobInvolvement	0	1	2.72	0.70	1	2.00	3.0	3.00	4	▁▃▁▇▁
JobLevel	0	1	2.04	1.09	1	1.00	2.0	3.00	5	▇▇▃▂▁
JobSatisfaction	0	1	2.71	1.11	1	2.00	3.0	4.00	4	▅▅▁▇▇
MonthlyIncome	0	1	6390.26	4597.70	1081	2839.50	4945.5	8182.00	19999	▇▅▂▁▁
MonthlyRate	0	1	14325.62	7108.38	2094	8092.00	14074.5	20456.25	26997	▇▇▇▇▇
NumCompaniesWorked	0	1	2.73	2.52	0	1.00	2.0	4.00	9	▇▃▂▂▁
PercentSalaryHike	0	1	15.20	3.68	11	12.00	14.0	18.00	25	▇▅▃▂▁
PerformanceRating	0	1	3.15	0.36	3	3.00	3.0	3.00	4	▇▁▁▁▂
RelationshipSatisfaction	0	1	2.71	1.10	1	2.00	3.0	4.00	4	▅▅▁▇▇
StockOptionLevel	0	1	0.78	0.86	0	0.00	1.0	1.00	3	▇▇▁▂▁
TotalWorkingYears	0	1	11.05	7.51	0	6.00	10.0	15.00	40	▇▇▂▁▁
TrainingTimesLastYear	0	1	2.83	1.27	0	2.00	3.0	3.00	6	▂▇▇▂▃
WorkLifeBalance	0	1	2.78	0.71	1	2.00	3.0	3.00	4	▁▃▁▇▂
YearsAtCompany	0	1	6.96	6.02	0	3.00	5.0	10.00	40	▇▃▁▁▁
YearsInCurrentRole	0	1	4.20	3.64	0	2.00	3.0	7.00	18	▇▃▂▁▁
YearsSinceLastPromotion	0	1	2.17	3.19	0	0.00	1.0	3.00	15	▇▁▁▁▁
YearsWithCurrManager	0	1	4.14	3.57	0	2.00	3.0	7.00	17	▇▂▅▁▁

By skim(), we can check again the new dataset and all these three columns have been dropped.

I still want to drop the columns ID and EmployeeNumber. These variables are not related to Salary or Attrition and not usefull for our analysis. They are related to individual identity of each employee. After dropping, I will run skim() to check again the dataset.

rawdata <- select(rawdata, -c("ID","EmployeeNumber"))
skim(rawdata)

Data summary

Name	rawdata
Number of rows	870
Number of columns	31
_______________________
Column type frequency:
factor	8
numeric	23
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
Attrition	0	1	FALSE	2	No: 730, Yes: 140
BusinessTravel	0	1	FALSE	3	Tra: 618, Tra: 158, Non: 94
Department	0	1	FALSE	3	Res: 562, Sal: 273, Hum: 35
EducationField	0	1	FALSE	6	Lif: 358, Med: 270, Mar: 100, Tec: 75
Gender	0	1	FALSE	2	Mal: 516, Fem: 354
JobRole	0	1	FALSE	9	Sal: 200, Res: 172, Lab: 153, Man: 87
MaritalStatus	0	1	FALSE	3	Mar: 410, Sin: 269, Div: 191
OverTime	0	1	FALSE	2	No: 618, Yes: 252

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Age	0	1	36.83	8.93	18	30.0	35.0	43.00	60	▂▇▇▃▂
DailyRate	0	1	815.23	401.12	103	472.5	817.5	1165.75	1499	▇▇▇▇▇
DistanceFromHome	0	1	9.34	8.14	1	2.0	7.0	14.00	29	▇▅▂▂▂
Education	0	1	2.90	1.02	1	2.0	3.0	4.00	5	▂▅▇▆▁
EnvironmentSatisfaction	0	1	2.70	1.10	1	2.0	3.0	4.00	4	▅▆▁▇▇
HourlyRate	0	1	65.61	20.13	30	48.0	66.0	83.00	100	▇▇▆▇▇
JobInvolvement	0	1	2.72	0.70	1	2.0	3.0	3.00	4	▁▃▁▇▁
JobLevel	0	1	2.04	1.09	1	1.0	2.0	3.00	5	▇▇▃▂▁
JobSatisfaction	0	1	2.71	1.11	1	2.0	3.0	4.00	4	▅▅▁▇▇
MonthlyIncome	0	1	6390.26	4597.70	1081	2839.5	4945.5	8182.00	19999	▇▅▂▁▁
MonthlyRate	0	1	14325.62	7108.38	2094	8092.0	14074.5	20456.25	26997	▇▇▇▇▇
NumCompaniesWorked	0	1	2.73	2.52	0	1.0	2.0	4.00	9	▇▃▂▂▁
PercentSalaryHike	0	1	15.20	3.68	11	12.0	14.0	18.00	25	▇▅▃▂▁
PerformanceRating	0	1	3.15	0.36	3	3.0	3.0	3.00	4	▇▁▁▁▂
RelationshipSatisfaction	0	1	2.71	1.10	1	2.0	3.0	4.00	4	▅▅▁▇▇
StockOptionLevel	0	1	0.78	0.86	0	0.0	1.0	1.00	3	▇▇▁▂▁
TotalWorkingYears	0	1	11.05	7.51	0	6.0	10.0	15.00	40	▇▇▂▁▁
TrainingTimesLastYear	0	1	2.83	1.27	0	2.0	3.0	3.00	6	▂▇▇▂▃
WorkLifeBalance	0	1	2.78	0.71	1	2.0	3.0	3.00	4	▁▃▁▇▂
YearsAtCompany	0	1	6.96	6.02	0	3.0	5.0	10.00	40	▇▃▁▁▁
YearsInCurrentRole	0	1	4.20	3.64	0	2.0	3.0	7.00	18	▇▃▂▁▁
YearsSinceLastPromotion	0	1	2.17	3.19	0	0.0	1.0	3.00	15	▇▁▁▁▁
YearsWithCurrManager	0	1	4.14	3.57	0	2.0	3.0	7.00	17	▇▂▅▁▁

Then now we have 31 columns in the dataset.

5. Pre-processing the data:

I will convert these numeric variables to factor variables.

factorcolumns <- c("JobInvolvement", "JobSatisfaction", "PerformanceRating", "RelationshipSatisfaction", "WorkLifeBalance")

rawdata[,factorcolumns] <- lapply(rawdata[,factorcolumns], as.factor)
data0 <- rawdata #data0 - dataset that I use for the analysis
skim(data0)

Data summary

Name	data0
Number of rows	870
Number of columns	31
_______________________
Column type frequency:
factor	13
numeric	18
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
Attrition	0	1	FALSE	2	No: 730, Yes: 140
BusinessTravel	0	1	FALSE	3	Tra: 618, Tra: 158, Non: 94
Department	0	1	FALSE	3	Res: 562, Sal: 273, Hum: 35
EducationField	0	1	FALSE	6	Lif: 358, Med: 270, Mar: 100, Tec: 75
Gender	0	1	FALSE	2	Mal: 516, Fem: 354
JobInvolvement	0	1	FALSE	4	3: 514, 2: 228, 4: 81, 1: 47
JobRole	0	1	FALSE	9	Sal: 200, Res: 172, Lab: 153, Man: 87
JobSatisfaction	0	1	FALSE	4	4: 271, 3: 254, 1: 179, 2: 166
MaritalStatus	0	1	FALSE	3	Mar: 410, Sin: 269, Div: 191
OverTime	0	1	FALSE	2	No: 618, Yes: 252
PerformanceRating	0	1	FALSE	2	3: 738, 4: 132
RelationshipSatisfaction	0	1	FALSE	4	4: 264, 3: 261, 1: 174, 2: 171
WorkLifeBalance	0	1	FALSE	4	3: 532, 2: 192, 4: 98, 1: 48

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Age	0	1	36.83	8.93	18	30.0	35.0	43.00	60	▂▇▇▃▂
DailyRate	0	1	815.23	401.12	103	472.5	817.5	1165.75	1499	▇▇▇▇▇
DistanceFromHome	0	1	9.34	8.14	1	2.0	7.0	14.00	29	▇▅▂▂▂
Education	0	1	2.90	1.02	1	2.0	3.0	4.00	5	▂▅▇▆▁
EnvironmentSatisfaction	0	1	2.70	1.10	1	2.0	3.0	4.00	4	▅▆▁▇▇
HourlyRate	0	1	65.61	20.13	30	48.0	66.0	83.00	100	▇▇▆▇▇
JobLevel	0	1	2.04	1.09	1	1.0	2.0	3.00	5	▇▇▃▂▁
MonthlyIncome	0	1	6390.26	4597.70	1081	2839.5	4945.5	8182.00	19999	▇▅▂▁▁
MonthlyRate	0	1	14325.62	7108.38	2094	8092.0	14074.5	20456.25	26997	▇▇▇▇▇
NumCompaniesWorked	0	1	2.73	2.52	0	1.0	2.0	4.00	9	▇▃▂▂▁
PercentSalaryHike	0	1	15.20	3.68	11	12.0	14.0	18.00	25	▇▅▃▂▁
StockOptionLevel	0	1	0.78	0.86	0	0.0	1.0	1.00	3	▇▇▁▂▁
TotalWorkingYears	0	1	11.05	7.51	0	6.0	10.0	15.00	40	▇▇▂▁▁
TrainingTimesLastYear	0	1	2.83	1.27	0	2.0	3.0	3.00	6	▂▇▇▂▃
YearsAtCompany	0	1	6.96	6.02	0	3.0	5.0	10.00	40	▇▃▁▁▁
YearsInCurrentRole	0	1	4.20	3.64	0	2.0	3.0	7.00	18	▇▃▂▁▁
YearsSinceLastPromotion	0	1	2.17	3.19	0	0.0	1.0	3.00	15	▇▁▁▁▁
YearsWithCurrManager	0	1	4.14	3.57	0	2.0	3.0	7.00	17	▇▂▅▁▁

Then now we have 13 factor columns and 18 numeric columns in the dataset.

In the next part, I will do Exploratory Data Analysis (or EDA). First, I will analyze the dataset in each variable.

III. EDA1 - Analysis of each variable and some related variables

First, I will analyze the dataset by analyzing each variable by visualization. We have 870 observations in total (employees).

I also convert the other variables to factor. I will work on the dataset data1 (<-data0).

data1 <- data0

factorcolumns1 <- c("Education", "EnvironmentSatisfaction", "JobLevel", "NumCompaniesWorked", "PercentSalaryHike",  "StockOptionLevel", "TotalWorkingYears", "TrainingTimesLastYear", "YearsAtCompany", "YearsInCurrentRole",  "YearsSinceLastPromotion", "YearsWithCurrManager")
data1[,factorcolumns1] <- lapply(data1[,factorcolumns1], as.factor)
skim(data1)

Data summary

Name	data1
Number of rows	870
Number of columns	31
_______________________
Column type frequency:
factor	25
numeric	6
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
Attrition	0	1	FALSE	2	No: 730, Yes: 140
BusinessTravel	0	1	FALSE	3	Tra: 618, Tra: 158, Non: 94
Department	0	1	FALSE	3	Res: 562, Sal: 273, Hum: 35
Education	0	1	FALSE	5	3: 324, 4: 240, 2: 182, 1: 98
EducationField	0	1	FALSE	6	Lif: 358, Med: 270, Mar: 100, Tec: 75
EnvironmentSatisfaction	0	1	FALSE	4	4: 262, 3: 258, 2: 178, 1: 172
Gender	0	1	FALSE	2	Mal: 516, Fem: 354
JobInvolvement	0	1	FALSE	4	3: 514, 2: 228, 4: 81, 1: 47
JobLevel	0	1	FALSE	5	1: 329, 2: 312, 3: 132, 4: 60
JobRole	0	1	FALSE	9	Sal: 200, Res: 172, Lab: 153, Man: 87
JobSatisfaction	0	1	FALSE	4	4: 271, 3: 254, 1: 179, 2: 166
MaritalStatus	0	1	FALSE	3	Mar: 410, Sin: 269, Div: 191
NumCompaniesWorked	0	1	FALSE	10	1: 320, 0: 111, 3: 91, 4: 85
OverTime	0	1	FALSE	2	No: 618, Yes: 252
PercentSalaryHike	0	1	FALSE	15	11: 126, 13: 123, 14: 120, 12: 119
PerformanceRating	0	1	FALSE	2	3: 738, 4: 132
RelationshipSatisfaction	0	1	FALSE	4	4: 264, 3: 261, 1: 174, 2: 171
StockOptionLevel	0	1	FALSE	4	0: 379, 1: 355, 2: 81, 3: 55
TotalWorkingYears	0	1	FALSE	39	10: 132, 6: 72, 8: 61, 9: 58
TrainingTimesLastYear	0	1	FALSE	7	2: 309, 3: 308, 5: 75, 4: 73
WorkLifeBalance	0	1	FALSE	4	3: 532, 2: 192, 4: 98, 1: 48
YearsAtCompany	0	1	FALSE	32	1: 107, 5: 105, 3: 85, 2: 77
YearsInCurrentRole	0	1	FALSE	19	2: 223, 0: 151, 7: 136, 3: 68
YearsSinceLastPromotion	0	1	FALSE	16	0: 342, 1: 214, 2: 94, 7: 41
YearsWithCurrManager	0	1	FALSE	17	2: 202, 0: 166, 7: 131, 3: 76

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Age	0	1	36.83	8.93	18	30.0	35.0	43.00	60	▂▇▇▃▂
DailyRate	0	1	815.23	401.12	103	472.5	817.5	1165.75	1499	▇▇▇▇▇
DistanceFromHome	0	1	9.34	8.14	1	2.0	7.0	14.00	29	▇▅▂▂▂
HourlyRate	0	1	65.61	20.13	30	48.0	66.0	83.00	100	▇▇▆▇▇
MonthlyIncome	0	1	6390.26	4597.70	1081	2839.5	4945.5	8182.00	19999	▇▅▂▁▁
MonthlyRate	0	1	14325.62	7108.38	2094	8092.0	14074.5	20456.25	26997	▇▇▇▇▇

1. Monthly Income:

First, I will take a look at monthly income of employees by the following histogram.

x <- data1$MonthlyIncome 
h<-hist(x, breaks=10, col="steelblue", xlab="Monthly Income", 
        main="Histogram with Normal Curve for Monthly Income") 
xfit<-seq(min(x),max(x),length=40) 
yfit<-dnorm(xfit,mean=mean(x),sd=sd(x)) 
yfit <- yfit*diff(h$mids[1:2])*length(x) 
lines(xfit, yfit, col="red", lwd=2)

The following code will show the minimum and maximum salary of 870 employees in the dataset.

range(data1$MonthlyIncome)

## [1]  1081 19999

Then the Monthly Income is from 1081 USD to 19999 USD. By the histogram, it is right skewed. The question is that “Will we transform this variable before studying?”

By the histogram, we see most people have salary in the range [2000,4000] and second range is [4000,6000]. I will divide into 6 groups as follows: 1081 - <2000, 2000 - <4000, 4000 - <6000, 6000 - <10000, and from 10000 - <16000 and 16000 - <20000.

data1$IncomeGroup <- cut(data1$MonthlyIncome, c(0,2000,4000,6000,10000,16000,20000), labels = c("<$2000","$2000-$4000","$4000 - $6000","$6000-$10000","$10000-$16000","$16000-$200000"), include.lowest = TRUE)

By the following boxplot,

ggplot(data1, aes_string(x = "IncomeGroup", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Income Groups")+ xlab("Income Groups") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

and the following barplot,

ggplot(data1, aes_string("IncomeGroup")) + geom_bar(fill="steelblue") + xlab ("Monthly Income Group") + ylab("Number of Employees") +ggtitle("Monthly Income vs. Employee Groups")

we can see that:

• The salary less than 2000 USD is considered as in lower class.

• The salary from 2000 USD to 4000 USD is considered as in lower middle class and from 4000 USD to 6000 USD is considered as in middle class and from 6000 USD to 10000 USD is considered as in upper middle class.

• The salary from 10000 USD to 16000 USD is considered as in the lower high class and from 16000 USD to 20000 USD is considered as in the high class.

Now I will study the relationship between Income Group and Attrition.

ggplot(data1, aes_string(x = "IncomeGroup", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Income Group") + ylab("Percent numbers of employees")

• Then employees with lower Monthly Income will have more chance to leave the current jobs.

2. Attrition:

I will observe the atrrition data first to see the percentage of employees who left jobs.

stats <- function(df, x) {
  df %>% group_by_at(x) %>% 
    summarise(Count = n(), Proportion = scales::percent(n()/dim(df)[1])) %>% 
    kable() %>% kable_styling(full_width = FALSE)
}

stats(data1, "Attrition")

Attrition	Count	Proportion
No	730	83.9%
Yes	140	16.1%

ggplot(data1, aes_string("Attrition")) + geom_bar(fill="steelblue") + xlab ("Attrition") + ylab("Number of Employees") 

• Then there are 140/870 = 16.1 % left jobs (Attrition).

3. Age:

First, I will observe Ages of Employees in the dataset.

summary(data1$Age)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   18.00   30.00   35.00   36.83   43.00   60.00

• Then, Ages of Employees in this dataset are from 18 to 60 years old.

We can also use the following code to see the range of ages.

range(data1$Age)

## [1] 18 60

Now I will take a look at Age variable by the following histogram.

x <- data1$Age 
h<-hist(x, breaks=10, col="steelblue", xlab="Age", 
        main="Histogram with Normal Curve for Employee Ages") 
xfit<-seq(min(x),max(x),length=40) 
yfit<-dnorm(xfit,mean=mean(x),sd=sd(x)) 
yfit <- yfit*diff(h$mids[1:2])*length(x) 
lines(xfit, yfit, col="red", lwd=2)

• Most employees have Ages between 25 to 35.

We will see the relationship between Age and Attrition by the following barplot.

ggplot(data1, aes_string(x = "Age", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Age") + ylab("Percent numbers of employees")

• Employees with Ages between 18 - 21 don’t stay in the same job for long time.
  
• People with Age 58-60 don’t leave job.
  
• People with Age range 30-50 stay with job. They want to build their careers with the same company.

By the following Scatterplot, we can see the relationship between Age and Monthly Income.

ggplot(data1, aes_string(x = "Age", y = "MonthlyIncome")) + geom_point() + geom_smooth(method="lm")

By the histogram, I will divide Age into 4 groups: 18-25, 25-35, 35-45, 45-60.

data1$AgeGroup <- cut(data1$Age, c(18,25,35,45,60), labels = c("18-25","25-35","35-45","45-60"), include.lowest = TRUE)

Now I will study the relationship between Age groups and Attrition.

ggplot(data1, aes_string(x = "AgeGroup", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Age Groups") + ylab("Percentage of employees")

• Employees with Age range 18-25 will leave their current jobs more than other groups.
  
• Employees with Age range 35-45 will stay with their jobs to build their careers.

We can also see the relationship between Age Groups and Monthly Income here.

ggplot(data1, aes_string(x = "AgeGroup", y = "MonthlyIncome")) + geom_point() + geom_smooth(method="lm")

ggplot(data1, aes_string(x = "AgeGroup", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Age Groups")+ xlab("Age Groups") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Logically, employees with higher Ages have bigger Income.

4. Business Travel:

summary(data1$BusinessTravel)

##        Non-Travel Travel_Frequently     Travel_Rarely 
##                94               158               618

stats(data1,"BusinessTravel")

BusinessTravel	Count	Proportion
Non-Travel	94	10.8%
Travel_Frequently	158	18.2%
Travel_Rarely	618	71.0%

• Most employees travel rarely (618/870 = 71%).

Now I will study the relationship between Bussiness Travel and Age.

ggplot(data1, aes_string(x = "AgeGroup", fill = "BusinessTravel")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Age Groups") + ylab("Business Travel")

• Then the biggest percentage of frequent travel are for Age Group 25-35.
  
• The biggest percenatge of non-travel are for Age Group 35-45. They have stable job and family.
  
• The smallest percentage of non-travel are for Age Group 45-60.

Now we will see the relationship between Business Travel and Attrition.

ggplot(data1, aes_string(x = "BusinessTravel", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Business Travel") + ylab("Attrition")

• The most frequent travelers have the highest attrition rates.

ggplot(data1, aes_string(x = "BusinessTravel", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Business Travel Groups")+ xlab("Business Travel") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Non-Travel employee group has the lowest income.

5. Department:

summary(data1$Department)

##        Human Resources Research & Development                  Sales 
##                     35                    562                    273

stats(data1, "Department")

Department	Count	Proportion
Human Resources	35	4.02%
Research & Development	562	64.6%
Sales	273	31.4%

• 64.6 % employees work in Research and Developpment Department.
• Only 4.02% employees work in Human Resources.
  
• The job market needs more people for R&D or Sales Department.

ggplot(data1, aes_string(x = "Department", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Department") + ylab("Attrition")

• The Sales Department has the highest rates in Attrition.

ggplot(data1, aes_string(x = "Department", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Department")+ xlab("Department") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• The Mean Incomes are similar between Department groups.
  
• The Median Income is strongly different. HR Department has the lowest Median Income and Sales Department has the highest Median Income.

6. Distance from Home:

The following histogram will show us the distance from home of Employees.

x <- data1$DistanceFromHome
h<-hist(x, breaks=10, col="steelblue", xlab="Distance from Home", 
        main="Distance from Home vs. Number of Employees") 
xfit<-seq(min(x),max(x),length=40) 
yfit<-dnorm(xfit,mean=mean(x),sd=sd(x)) 
yfit <- yfit*diff(h$mids[1:2])*length(x) 
lines(xfit, yfit, col="red", lwd=2)

• Most employees work near home (less than 10 miles).

ggplot(data1, aes_string(x = "DistanceFromHome", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Distance from Home") + ylab("Attrition")

• The highest rates in Attrition for the Distance from Home between 21-23 miles. Actually, I don’t see strong relationship here.

7. Education:

stats(data1, "Education")

Education	Count	Proportion
1	98	11.3%
2	182	20.9%
3	324	37.2%
4	240	27.6%
5	26	2.99%

ggplot(data1, aes_string(x = "Education", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Education") + ylab("Attrition")

ggplot(data1, aes_string(x = "Education", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Education")+ xlab("Education") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees has the level 3 in Education.
  
• Higher level in Education has lower rates in Attrition.
  
• The Highest level in Education (level 5) has the Highest Monthly Income.

8. Education Field:

stats(data1, "EducationField")

EducationField	Count	Proportion
Human Resources	15	1.72%
Life Sciences	358	41.1%
Marketing	100	11.5%
Medical	270	31.0%
Other	52	5.98%
Technical Degree	75	8.62%

ggplot(data1, aes_string(x = "EducationField", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Education Field") + ylab("Attrition")

ggplot(data1, aes_string(x = "EducationField", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Education Field")+ xlab("Education Field") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees has formation in Life Science.
  
• The lowest median income is in Human Resouce but the highest pay is in HR.
  
• The highest median income is in Marketing field.

9. Environment Satisfaction:

stats(data1, "EnvironmentSatisfaction")

EnvironmentSatisfaction	Count	Proportion
1	172	19.8%
2	178	20.5%
3	258	29.7%
4	262	30.1%

ggplot(data1, aes_string(x = "EnvironmentSatisfaction", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Environment Satisfaction") + ylab("Attrition")

ggplot(data1, aes_string(x = "EnvironmentSatisfaction", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Environment Satisfaction")+ xlab("Environment Satisfaction") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees are sastified with their jobs.
  
• Employees who are less sastified with their jobs have the highest rates in Attrition.

10. Gender:

stats(data1, "Gender")

Gender	Count	Proportion
Female	354	40.7%
Male	516	59.3%

ggplot(data1, aes_string(x = "Gender", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Gender") + ylab("Attrition")

ggplot(data1, aes_string(x = "Gender", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Gender")+ xlab("Gender") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• The rates in Attrition variable are similar between Male and Female in Gender variable.
  
• Male group gain less than Female group in term of Median Income.

11. Job Involvement:

stats(data1, "JobInvolvement")

JobInvolvement	Count	Proportion
1	47	5.40%
2	228	26.2%
3	514	59.1%
4	81	9.31%

ggplot(data1, aes_string(x = "JobInvolvement", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Job Involvement") + ylab("Attrition")

ggplot(data1, aes_string(x = "JobInvolvement", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Job Involvement")+ xlab("Job Involvement") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Employees with lower job involvement have higher rates in Attrition.

12. Job Level:

stats(data1, "JobLevel")

JobLevel	Count	Proportion
1	329	37.8%
2	312	35.9%
3	132	15.2%
4	60	6.90%
5	37	4.25%

ggplot(data1, aes_string(x = "JobLevel", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Job Level") + ylab("Attrition")

ggplot(data1, aes_string(x = "JobLevel", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Job Level")+ xlab("Job Level") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Number of employees is lower when their job levels are higher.
  
• Employees with the lowest job level (1) have the highest rates in Attrition.
  
• The relationship between Job Level and Monthly Income is linear positively.

13. Job Role:

stats(data1, "JobRole")

JobRole	Count	Proportion
Healthcare Representative	76	8.74%
Human Resources	27	3.10%
Laboratory Technician	153	17.6%
Manager	51	5.86%
Manufacturing Director	87	10.0%
Research Director	51	5.86%
Research Scientist	172	19.8%
Sales Executive	200	23.0%
Sales Representative	53	6.09%

ggplot(data1, aes_string(x = "JobRole", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Job Role") + ylab("Attrition")

ggplot(data1, aes_string(x = "JobRole", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Job Role")+ xlab("Job Role") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Sales Representatives have the highest rates in Attrition and low pay.
• Manufacturing Directors and Reseach Directors have the lowest rates in Attrition.
  
• Managers and Research Directors have the highest pay and low rates in Attrition.

14. Job Satisfaction:

stats(data1, "JobSatisfaction")

JobSatisfaction	Count	Proportion
1	179	20.6%
2	166	19.1%
3	254	29.2%
4	271	31.1%

ggplot(data1, aes_string(x = "JobSatisfaction", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Job Satisfaction") + ylab("Attrition")

ggplot(data1, aes_string(x = "JobSatisfaction", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Job Satisfaction")+ xlab("Job Satisfaction") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees are satisfied with their jobs.
  
• Those employees with lower job satisfaction level have higher rates in Attrition.
  
• Mean and Median Incomes are similar.

15. Marital Status:

stats(data1, "MaritalStatus")

MaritalStatus	Count	Proportion
Divorced	191	22.0%
Married	410	47.1%
Single	269	30.9%

ggplot(data1, aes_string(x = "MaritalStatus", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Marital Status") + ylab("Attrition")

ggplot(data1, aes_string(x = "MaritalStatus", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Marital Status")+ xlab("Marital Status") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees are married.
  
• Single employees have the highest attrition and below average pay.

16. Number of Companies Worked:

stats(data1, "NumCompaniesWorked")

NumCompaniesWorked	Count	Proportion
0	111	12.8%
1	320	36.8%
2	74	8.51%
3	91	10.5%
4	85	9.77%
5	43	4.94%
6	39	4.48%
7	46	5.29%
8	28	3.22%
9	33	3.79%

ggplot(data1, aes_string(x = "NumCompaniesWorked", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Number of Companies Worked") + ylab("Attrition")

ggplot(data1, aes_string(x = "NumCompaniesWorked", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Number of Companies Worked")+ xlab("Number of Companies Worked") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• In the dataset, we can see the number of companies that employees worked is 0. Then it is difficult to understand the concept. I think that the number of companies that employees had worked before starting the job in this company in order to make sense.
  
• Who have worked at some companies have higher rates in Attrition.

17. Over Time:

stats(data1, "OverTime")

OverTime	Count	Proportion
No	618	71.0%
Yes	252	29.0%

ggplot(data1, aes_string(x = "OverTime", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Overtime") + ylab("Attrition")

ggplot(data1, aes_string(x = "OverTime", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Overtime")+ xlab("Overtime") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees don’t work overtime.
  
• Who have to work overtime have higher rates in Attrition and lower income.

18. Percent Salary Hike:

stats(data1, "PercentSalaryHike")

PercentSalaryHike	Count	Proportion
11	126	14.5%
12	119	13.7%
13	123	14.1%
14	120	13.8%
15	54	6.21%
16	43	4.94%
17	56	6.44%
18	57	6.55%
19	40	4.60%
20	27	3.10%
21	33	3.79%
22	30	3.45%
23	17	1.95%
24	14	1.61%
25	11	1.26%

ggplot(data1, aes_string(x = "PercentSalaryHike", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Percent Salary Hike") + ylab("Attrition")

ggplot(data1, aes_string(x = "PercentSalaryHike", y = "MonthlyIncome", fill = x)) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Percent Salary Hike")+ xlab("Percent Salary Hike") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Who have Percent Salary Hike between 22-24% have lower Mean Monthly Income and higher rates in Attrition.

19. Performance Rating:

stats(data1, "PerformanceRating")

PerformanceRating	Count	Proportion
3	738	84.8%
4	132	15.2%

ggplot(data1, aes_string(x = "PerformanceRating", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Performance Rating") + ylab("Attrition")

ggplot(data1, aes_string(x = "PerformanceRating", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Performance Rating")+ xlab("Performance Rating") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• There are only 2 ratings and the results are similar.
• I will want to remove this variable because it is a self rating and the results will not affect to our analysis.

20. Relationship Satisfaction:

stats(data1, "RelationshipSatisfaction")

RelationshipSatisfaction	Count	Proportion
1	174	20.0%
2	171	19.7%
3	261	30.0%
4	264	30.3%

ggplot(data1, aes_string(x = "RelationshipSatisfaction", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Relationship Satisfaction") + ylab("Attrition")

ggplot(data1, aes_string(x = "RelationshipSatisfaction", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Relationship Satisfaction")+ xlab("Relationship Satisfaction") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Relationship Satisfaction divides into 4 groups similarly.
  
• Employees with low Relationship Satisfaction have high rates in Attrition.
  
• Mean and Median Income are similar between groups.

21. Stock Option Level:

stats(data1, "StockOptionLevel")

StockOptionLevel	Count	Proportion
0	379	43.6%
1	355	40.8%
2	81	9.31%
3	55	6.32%

ggplot(data1, aes_string(x = "StockOptionLevel", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Stock Option Level") + ylab("Attrition")

ggplot(data1, aes_string(x = "StockOptionLevel", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Stock Option Level")+ xlab("Stock Option Level") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees fall in Stock Option level 0 or 1.
  
• Stock option levels 0 and 3 have the highest rates in Attrition and lowest median incomes.

22. Total Working Years:

stats(data1, "TotalWorkingYears")

TotalWorkingYears	Count	Proportion
0	7	0.805%
1	48	5.52%
2	20	2.30%
3	27	3.10%
4	35	4.02%
5	49	5.63%
6	72	8.28%
7	47	5.40%
8	61	7.01%
9	58	6.67%
10	132	15.2%
11	20	2.30%
12	23	2.64%
13	25	2.87%
14	22	2.53%
15	29	3.33%
16	24	2.76%
17	17	1.95%
18	13	1.49%
19	13	1.49%
20	17	1.95%
21	17	1.95%
22	14	1.61%
23	14	1.61%
24	9	1.03%
25	6	0.690%
26	8	0.920%
27	3	0.345%
28	6	0.690%
29	4	0.460%
30	5	0.575%
31	6	0.690%
32	6	0.690%
33	2	0.230%
34	3	0.345%
35	2	0.230%
36	4	0.460%
37	1	0.115%
40	1	0.115%

ggplot(data1, aes_string(x = "TotalWorkingYears", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16) + xlab("Total Working Years") + ylab("Attrition")

ggplot(data1, aes_string(x = "TotalWorkingYears", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Total Working Years")+ xlab("Total Working Years") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Income increases linearly with total working years.
  
• Employees have lower total working years have higher rates in Attrition.
  
• Especialy, who have 40 years of working have 100% rates in Attrition (retirement?)
  
• Employees have 34-39 years of working don’t leave jobs, waiting for retirement and full benefits?

23. Training Times Last Year:

stats(data1, "TrainingTimesLastYear")

TrainingTimesLastYear	Count	Proportion
0	30	3.45%
1	39	4.48%
2	309	35.5%
3	308	35.4%
4	73	8.39%
5	75	8.62%
6	36	4.14%

ggplot(data1, aes_string(x = "TrainingTimesLastYear", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Training Times Last Year") + ylab("Attrition")

ggplot(data1, aes_string(x = "TrainingTimesLastYear", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Training Times Last Year")+ xlab("Training Times Last Years") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most Employees had 2 or 3 training times last year.
• Employees had 0 or 4 training times last year have higher rates in Attrition.
  
• Employees had 5 or 6 training times last year have the lowest rates in Attrition.
  
• Suprisingly, who had no training time last year have the highest Median and Mean Income.

24. Work Life Balance:

stats(data1, "WorkLifeBalance")

WorkLifeBalance	Count	Proportion
1	48	5.52%
2	192	22.1%
3	532	61.1%
4	98	11.3%

ggplot(data1, aes_string(x = "WorkLifeBalance", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Work Life Balance") + ylab("Attrition")

ggplot(data1, aes_string(x = "WorkLifeBalance", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Work Life Balance")+ xlab("Work Life Balance") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Those have bad work life balance then have higher rates in Attrition and lower income.

25. Years At Company:

stats(data1, "YearsAtCompany")

YearsAtCompany	Count	Proportion
0	28	3.22%
1	107	12.3%
2	77	8.85%
3	85	9.77%
4	54	6.21%
5	105	12.1%
6	44	5.06%
7	42	4.83%
8	50	5.75%
9	52	5.98%
10	77	8.85%
11	17	1.95%
12	9	1.03%
13	20	2.30%
14	14	1.61%
15	11	1.26%
16	6	0.690%
17	5	0.575%
18	8	0.920%
19	8	0.920%
20	14	1.61%
21	6	0.690%
22	12	1.38%
23	1	0.115%
24	4	0.460%
25	2	0.230%
26	3	0.345%
30	1	0.115%
31	2	0.230%
32	3	0.345%
33	2	0.230%
40	1	0.115%

ggplot(data1, aes_string(x = "YearsAtCompany", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("Years At Company") + ylab("Attrition")

ggplot(data1, aes_string(x = "YearsAtCompany", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. Years At Company")+ xlab("Years At Company") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Income increases linearly with Years at Company.
  
• Employees have lower Years at Company have higher rates in Attrition.
  
• Especialy, who have 40 Years at Company have 100% rates in Attrition (retirement?)

26. Years In Current Role:

stats(data1, "YearsInCurrentRole")

YearsInCurrentRole	Count	Proportion
0	151	17.4%
1	38	4.37%
2	223	25.6%
3	68	7.82%
4	53	6.09%
5	26	2.99%
6	17	1.95%
7	136	15.6%
8	56	6.44%
9	40	4.60%
10	14	1.61%
11	15	1.72%
12	7	0.805%
13	9	1.03%
14	7	0.805%
15	3	0.345%
16	3	0.345%
17	3	0.345%
18	1	0.115%

ggplot(data1, aes_string(x = "YearsInCurrentRole", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("YearsInCurrentRole") + ylab("Attrition")

ggplot(data1, aes_string(x = "YearsInCurrentRole", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. YearsInCurrentRole")+ xlab("YearsInCurrentRole") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• It’s a linear relationship between Monthly Income and Years in Current Role.
  
• Who stay more than 15 years in current role don’t leave their jobs.

27. Years Since Last Promotion:

stats(data1, "YearsSinceLastPromotion")

YearsSinceLastPromotion	Count	Proportion
0	342	39.3%
1	214	24.6%
2	94	10.8%
3	32	3.68%
4	32	3.68%
5	30	3.45%
6	23	2.64%
7	41	4.71%
8	12	1.38%
9	9	1.03%
10	4	0.460%
11	14	1.61%
12	5	0.575%
13	5	0.575%
14	5	0.575%
15	8	0.920%

ggplot(data1, aes_string(x = "YearsSinceLastPromotion", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("YearsSinceLastPromotion") + ylab("Attrition")

ggplot(data1, aes_string(x = "YearsSinceLastPromotion", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Monthly Income vs. YearsSinceLastPromotion")+ xlab("YearsSinceLastPromotion") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• The highest Mean Income is for 12 Years and zero rate in Attrition.

28. Years With Current Manager:

stats(data1, "YearsWithCurrManager")

YearsWithCurrManager	Count	Proportion
0	166	19.1%
1	40	4.60%
2	202	23.2%
3	76	8.74%
4	51	5.86%
5	22	2.53%
6	12	1.38%
7	131	15.1%
8	68	7.82%
9	44	5.06%
10	18	2.07%
11	11	1.26%
12	13	1.49%
13	7	0.805%
14	4	0.460%
15	1	0.115%
17	4	0.460%

ggplot(data1, aes_string(x = "YearsWithCurrManager", fill = "Attrition")) +
    geom_bar(position = "fill") +
    scale_y_continuous(labels = scales::percent) + 
    geom_abline(slope = 0, intercept = .16) + xlab("YearsWithCurrManager") + ylab("Attrition")

ggplot(data1, aes_string(x = "YearsWithCurrManager", y = "MonthlyIncome")) + 
  geom_boxplot(colour = "black", fill = "steelblue")+ ggtitle("Distribution between Monthly Income vs. YearsWithCurrManager")+ xlab("YearsWithCurrManager") + ylab("Monthly Income") + stat_summary(fun.y=mean, geom="point", shape=5, size=4) 

• Most employees have 2 years working with the current managers. After that, maybe they move to another companies and promote to next levels?
  
• People with 12, 13, 15,16 years with the same managers have zero rate in Attrition.
  
• Employees have 14 years with the same managers have the highest Mean and Median Income.

29. Hourly Rate vs Daily Rate vs Monthly Rate vs Monthly Income:

There are 4 similar variables HourlyRate, DailyRate, MonthlyRate, MonthlyIncome. I will see the relationship of these 3 first variables with MonthlyIncome and these 4 variables with Attrition.

ggpairs(data = data1, 
              mapping = aes(color = Attrition),
              columns = c("HourlyRate","DailyRate","MonthlyRate","MonthlyIncome"))

• Weak relationship between HourlyRate/DailyRate/MonthlyRate.
  
• No meaningful relationship between MonthlyIncome with HourlyRate/DailyRate/MonthlyRate.
  
• No meaningful relationship between Attrition with HourlyRate/DailyRate/MonthlyRate.

Then I will not consider these variables in the future analysis.

30. Satisfaction level:

There are 3 variables related to Satisfaction level: EnvironmentSatisfaction, JobSatisfaction, RelationshipSatisfaction.

First, I will change these variables from factor to numeric.

numcolumns <- c("EnvironmentSatisfaction", "JobSatisfaction", "RelationshipSatisfaction")
data1[,numcolumns] <- lapply(data1[,numcolumns], as.numeric)

data1$Satisfaction <-   as.factor(round((data1$EnvironmentSatisfaction +data1$JobSatisfaction+ 
                                     data1$RelationshipSatisfaction)/3))


stats(data1, "Satisfaction")

Satisfaction	Count	Proportion
1	24	2.76%
2	296	34.0%
3	455	52.3%
4	95	10.9%

ggplot(data1, aes_string(x = "Satisfaction", fill = "Attrition")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16)

ggplot(data1, aes_string(x = "Satisfaction", fill = "IncomeGroup")) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = scales::percent) + 
  geom_abline(slope = 0, intercept = .16)

• Most employees have level 2 or 3 in Satisfaction.
  
• Employees with the level 4 in Satisfaction have the lowest rates in Attrition.
  
• More employees with the highest Salary and less employees with the lowest Salary have the level 4 in Satisfaction.

32. Conclusion:

• As the above analyses, I will keep the variable MonthlyIncome and drop 3 variables HourlyRate, DailyRate and MonthlyRate.
  
• I will also drop the PerformanceRating variable.

After the first analyses on each variable,I will create a new dataset as follows.

data2 <- select(data0, -c("HourlyRate","DailyRate", "MonthlyRate","PerformanceRating"))
skim(data2)

Data summary

Name	data2
Number of rows	870
Number of columns	27
_______________________
Column type frequency:
factor	12
numeric	15
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
Attrition	0	1	FALSE	2	No: 730, Yes: 140
BusinessTravel	0	1	FALSE	3	Tra: 618, Tra: 158, Non: 94
Department	0	1	FALSE	3	Res: 562, Sal: 273, Hum: 35
EducationField	0	1	FALSE	6	Lif: 358, Med: 270, Mar: 100, Tec: 75
Gender	0	1	FALSE	2	Mal: 516, Fem: 354
JobInvolvement	0	1	FALSE	4	3: 514, 2: 228, 4: 81, 1: 47
JobRole	0	1	FALSE	9	Sal: 200, Res: 172, Lab: 153, Man: 87
JobSatisfaction	0	1	FALSE	4	4: 271, 3: 254, 1: 179, 2: 166
MaritalStatus	0	1	FALSE	3	Mar: 410, Sin: 269, Div: 191
OverTime	0	1	FALSE	2	No: 618, Yes: 252
RelationshipSatisfaction	0	1	FALSE	4	4: 264, 3: 261, 1: 174, 2: 171
WorkLifeBalance	0	1	FALSE	4	3: 532, 2: 192, 4: 98, 1: 48

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Age	0	1	36.83	8.93	18	30.0	35.0	43	60	▂▇▇▃▂
DistanceFromHome	0	1	9.34	8.14	1	2.0	7.0	14	29	▇▅▂▂▂
Education	0	1	2.90	1.02	1	2.0	3.0	4	5	▂▅▇▆▁
EnvironmentSatisfaction	0	1	2.70	1.10	1	2.0	3.0	4	4	▅▆▁▇▇
JobLevel	0	1	2.04	1.09	1	1.0	2.0	3	5	▇▇▃▂▁
MonthlyIncome	0	1	6390.26	4597.70	1081	2839.5	4945.5	8182	19999	▇▅▂▁▁
NumCompaniesWorked	0	1	2.73	2.52	0	1.0	2.0	4	9	▇▃▂▂▁
PercentSalaryHike	0	1	15.20	3.68	11	12.0	14.0	18	25	▇▅▃▂▁
StockOptionLevel	0	1	0.78	0.86	0	0.0	1.0	1	3	▇▇▁▂▁
TotalWorkingYears	0	1	11.05	7.51	0	6.0	10.0	15	40	▇▇▂▁▁
TrainingTimesLastYear	0	1	2.83	1.27	0	2.0	3.0	3	6	▂▇▇▂▃
YearsAtCompany	0	1	6.96	6.02	0	3.0	5.0	10	40	▇▃▁▁▁
YearsInCurrentRole	0	1	4.20	3.64	0	2.0	3.0	7	18	▇▃▂▁▁
YearsSinceLastPromotion	0	1	2.17	3.19	0	0.0	1.0	3	15	▇▁▁▁▁
YearsWithCurrManager	0	1	4.14	3.57	0	2.0	3.0	7	17	▇▂▅▁▁

IV. EDA2 - T-test Analysis

1. t-test Analysis on Attrition variable:

t.Age <- t.test(Age~Attrition, data=data2)
t.Age

## 
##  Welch Two Sample t-test
## 
## data:  Age by Attrition
## t = 4.1509, df = 184.91, p-value = 5.05e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  1.902905 5.350324
## sample estimates:
##  mean in group No mean in group Yes 
##          37.41233          33.78571

t.MonthlyIncome <-  t.test(MonthlyIncome~Attrition, data=data2)
t.MonthlyIncome

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Attrition
## t = 5.3249, df = 228.45, p-value = 2.412e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  1220.382 2654.047
## sample estimates:
##  mean in group No mean in group Yes 
##          6702.000          4764.786

t.Education <-  t.test(Education~Attrition, data=data2)
t.Education

## 
##  Welch Two Sample t-test
## 
## data:  Education by Attrition
## t = 1.4738, df = 197.94, p-value = 0.1421
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.04651063  0.32165740
## sample estimates:
##  mean in group No mean in group Yes 
##          2.923288          2.785714

t.DistanceFromHome <-  t.test(DistanceFromHome~Attrition, data=data2)
t.DistanceFromHome

## 
##  Welch Two Sample t-test
## 
## data:  DistanceFromHome by Attrition
## t = -2.4218, df = 186.03, p-value = 0.01641
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -3.4992554 -0.3574961
## sample estimates:
##  mean in group No mean in group Yes 
##          9.028767         10.957143

t.EnvironmentSatisfaction <-  t.test(EnvironmentSatisfaction~Attrition, data=data2)
t.EnvironmentSatisfaction

## 
##  Welch Two Sample t-test
## 
## data:  EnvironmentSatisfaction by Attrition
## t = 2.1362, df = 185.27, p-value = 0.03397
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.01768369 0.44474293
## sample estimates:
##  mean in group No mean in group Yes 
##          2.738356          2.507143

t.JobLevel <-  t.test(JobLevel~Attrition, data=data2)
t.JobLevel

## 
##  Welch Two Sample t-test
## 
## data:  JobLevel by Attrition
## t = 5.231, df = 211.76, p-value = 4.042e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.2995698 0.6618784
## sample estimates:
##  mean in group No mean in group Yes 
##          2.116438          1.635714

t.NumCompaniesWorked  <-  t.test(NumCompaniesWorked ~Attrition, data=data2)
t.NumCompaniesWorked 

## 
##  Welch Two Sample t-test
## 
## data:  NumCompaniesWorked by Attrition
## t = -1.6637, df = 183.57, p-value = 0.09788
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.91435932  0.07776441
## sample estimates:
##  mean in group No mean in group Yes 
##          2.660274          3.078571

t.PercentSalaryHike  <-  t.test(PercentSalaryHike ~Attrition, data=data2)
t.PercentSalaryHike

## 
##  Welch Two Sample t-test
## 
## data:  PercentSalaryHike by Attrition
## t = -0.42788, df = 187.22, p-value = 0.6692
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.8596808  0.5532229
## sample estimates:
##  mean in group No mean in group Yes 
##          15.17534          15.32857

t.StockOptionLevel  <-  t.test(StockOptionLevel ~Attrition, data=data2)
t.StockOptionLevel

## 
##  Welch Two Sample t-test
## 
## data:  StockOptionLevel by Attrition
## t = 4.216, df = 187.92, p-value = 3.86e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.1845700 0.5091678
## sample estimates:
##  mean in group No mean in group Yes 
##         0.8397260         0.4928571

t.TotalWorkingYears  <-  t.test(TotalWorkingYears ~Attrition, data=data2)
t.TotalWorkingYears

## 
##  Welch Two Sample t-test
## 
## data:  TotalWorkingYears by Attrition
## t = 5.1364, df = 201.19, p-value = 6.596e-07
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  2.105259 4.728792
## sample estimates:
##  mean in group No mean in group Yes 
##         11.602740          8.185714

t.TrainingTimesLastYear  <-  t.test(TrainingTimesLastYear ~Attrition, data=data2)
t.TrainingTimesLastYear

## 
##  Welch Two Sample t-test
## 
## data:  TrainingTimesLastYear by Attrition
## t = 1.8954, df = 200.36, p-value = 0.05948
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.00876413  0.44301071
## sample estimates:
##  mean in group No mean in group Yes 
##          2.867123          2.650000

t.YearsAtCompany  <-  t.test(YearsAtCompany ~Attrition, data=data2)
t.YearsAtCompany

## 
##  Welch Two Sample t-test
## 
## data:  YearsAtCompany by Attrition
## t = 3.7256, df = 191.55, p-value = 0.0002563
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.9922099 3.2248155
## sample estimates:
##  mean in group No mean in group Yes 
##          7.301370          5.192857

t.YearsInCurrentRole  <-  t.test(YearsInCurrentRole ~Attrition, data=data2)
t.YearsInCurrentRole

## 
##  Welch Two Sample t-test
## 
## data:  YearsInCurrentRole by Attrition
## t = 4.9513, df = 208, p-value = 1.522e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.9306052 2.1619584
## sample estimates:
##  mean in group No mean in group Yes 
##          4.453425          2.907143

t.YearsSinceLastPromotion  <-  t.test(YearsSinceLastPromotion ~Attrition, data=data2)
t.YearsSinceLastPromotion

## 
##  Welch Two Sample t-test
## 
## data:  YearsSinceLastPromotion by Attrition
## t = 0.12796, df = 187.59, p-value = 0.8983
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.5712911  0.6505475
## sample estimates:
##  mean in group No mean in group Yes 
##          2.175342          2.135714

t.YearsWithCurrManager <-  t.test(YearsWithCurrManager ~Attrition, data=data2)
t.YearsWithCurrManager

## 
##  Welch Two Sample t-test
## 
## data:  YearsWithCurrManager by Attrition
## t = 4.6826, df = 209.75, p-value = 5.084e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.8262439 2.0277679
## sample estimates:
##  mean in group No mean in group Yes 
##          4.369863          2.942857

testnames <- c("Age","Monthly Income", "Education",
               "Distance From Home", "Environment Satisfaction", 
               "Job Level", "Number of Companies Worked",
               "Percent Salary Hike", "Stock Option Level",
               "Total Working Years", "Training Times Last Year",
               "Years At Company", "Years In Current Role",
               "Years Since Last Promotion", "Years With Current Manager"
               )
testpval <- c(t.Age$p.value,
              t.MonthlyIncome$p.value,
              t.Education$p.value,
              t.DistanceFromHome$p.value,
              t.EnvironmentSatisfaction$p.value,
              t.JobLevel$p.value,
              t.NumCompaniesWorked$p.value,
              t.PercentSalaryHike$p.value,
              t.StockOptionLevel$p.value,
              t.TotalWorkingYears$p.value,
              t.TrainingTimesLastYear$p.value,
              t.YearsAtCompany$p.value,
              t.YearsInCurrentRole$p.value,
              t.YearsSinceLastPromotion$p.value,
              t.YearsWithCurrManager$p.value
              )
ttestout <- cbind.data.frame(testnames,testpval)
ttestout$testpval <- round(ttestout$testpval,10) 
names(ttestout) <- c("Variable","P-Value")

The p-values of t-test analyses related to Attrition variable:

ttestout %>% kable()

Variable	P-Value
Age	0.0000505
Monthly Income	0.0000002
Education	0.1421319
Distance From Home	0.0164052
Environment Satisfaction	0.0339727
Job Level	0.0000004
Number of Companies Worked	0.0978823
Percent Salary Hike	0.6692297
Stock Option Level	0.0000386
Total Working Years	0.0000007
Training Times Last Year	0.0594832
Years At Company	0.0002563
Years In Current Role	0.0000015
Years Since Last Promotion	0.8983165
Years With Current Manager	0.0000051

• There are two groups for Attrition variable (Yes and No).
  
• At \(\alpha\)-level of significance = 0.05, if p-value<0.05 then we reject the null hypothesis (There are some evidence to suggest that the mean difference in the selected variable for two groups Yes-No of Attrition variable) and if p-value>0.05 then we fail to reject the null hypothesis (There are not enough evidence to suggest that the mean difference in the selected variable for two groups Yes-No of Attrition variable).
  
• By t-test analysis, we will have some ideas to build our models later.

2. t-test Analysis related to Gender variable:

We now will use t-test to see the difference of Monthly Income in Job role between Male and Female.

summary(data2$JobRole)

## Healthcare Representative           Human Resources 
##                        76                        27 
##     Laboratory Technician                   Manager 
##                       153                        51 
##    Manufacturing Director         Research Director 
##                        87                        51 
##        Research Scientist           Sales Executive 
##                       172                       200 
##      Sales Representative 
##                        53

table(data2$Gender,data2$JobRole)

##         
##          Healthcare Representative Human Resources Laboratory Technician
##   Female                        33               9                    51
##   Male                          43              18                   102
##         
##          Manager Manufacturing Director Research Director
##   Female      25                     43                23
##   Male        26                     44                28
##         
##          Research Scientist Sales Executive Sales Representative
##   Female                 65              79                   26
##   Male                  107             121                   27

data2.Healthcare <- data2 %>% filter(JobRole=="Healthcare Representative")
data2.HR <- data2 %>% filter(JobRole=="Human Resources")
data2.Technician <- data2 %>% filter(JobRole=="Laboratory Technician")
data2.Manager <- data2 %>% filter(JobRole=="Manager")
data2.MDirector <- data2 %>% filter(JobRole=="Manufacturing Director")
data2.RDirector <- data2 %>% filter(JobRole=="Research Director")
data2.Scientist <- data2 %>% filter(JobRole=="Research Scientist")
data2.SExecutive <- data2 %>% filter(JobRole=="Sales Executive")
data2.SRepresentative <- data2 %>% filter(JobRole=="Sales Representative")

t.jHealthcare <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jHealthcare 

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jHR <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jHR 

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jTechnician <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jTechnician 

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jManager <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jManager

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jMDirector <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jMDirector

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jRDirector <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jRDirector

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jScientist <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jScientist

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jSExecutive <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jSExecutive

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

t.jSRepresentative <- t.test(MonthlyIncome ~ Gender, data = data2.Healthcare)
t.jSRepresentative

## 
##  Welch Two Sample t-test
## 
## data:  MonthlyIncome by Gender
## t = 0.24386, df = 71.024, p-value = 0.808
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -992.333 1268.880
## sample estimates:
## mean in group Female   mean in group Male 
##             7513.576             7375.302

testnames1 <- c("Healthcare Representative", "Human Resources", "Laboratory Technician",
               "Manager", "Manufacturing Director", "Research Director", "Research Scientist",
               "Sales Executive", "Sales Representative")
testpval1 <- c(t.jHealthcare$p.value,
              t.jHR$p.value,
              t.jTechnician$p.value,
              t.jManager$p.value,
              t.jMDirector$p.value,
              t.jRDirector$p.value,
              t.jScientist$p.value,
              t.jSExecutive$p.value,
              t.jSRepresentative$p.value
              )
ttestout1 <- cbind.data.frame(testnames1,testpval1)
ttestout1$testpval1 <- round(ttestout1$testpval1,10) 
names(ttestout1) <- c("Variable","P-Value")

The p-values of t-test analyses related to Monthly Income in Job role between Male and Female:

ttestout1 %>% kable()

Variable	P-Value
Healthcare Representative	0.8080436
Human Resources	0.8080436
Laboratory Technician	0.8080436
Manager	0.8080436
Manufacturing Director	0.8080436
Research Director	0.8080436
Research Scientist	0.8080436
Sales Executive	0.8080436
Sales Representative	0.8080436

• There are two groups Male and Female for Gender variable.
  
• At \(\alpha\)-level of significance = 0.05 and p-value>0.05 then we fail to reject the null hypothesis (There are not enough evidence to suggest that the mean difference in Monthly Income related to Job Role for two groups Male-Female of Gender variable).
  
• By t-test analysis, we will have some ideas to build our models later.

V. EDA3 - Numeric variables correlation

In this part, we will have more information related to Monthly Income and Attrition. We will combine our analysis on each variable in the last part.

The following table will show us the correlations between numeric variables.

correlator  <-  function(df){
 df %>%
    keep(is.numeric) %>%
    tidyr::drop_na() %>%
    cor %>%
    corrplot("upper", addCoef.col = "white", number.digits = 2,
             number.cex = 0.5, method="square",
             order="hclust", 
             tl.srt=50, tl.cex = 0.5)
}
correlator(data2)

#Actually, we can remove tidyr::drop_na() %>%  because there is no missing data in this dataset

#We can write the same code directly without using function as follows
#data2 %>% keep(is.numeric) %>% na.omit %>% cor %>% corrplot("upper", addCoef.col = "white", number.digits = 2, number.cex = 0.5, method="square", order="hclust", tl.srt=50, tl.cex = 0.5)

#We can remove na.omit %>% because there is no missing data in this dataset

1. Analysis on Monthly Income

By this correlation table, we see

Relationship	MonthlyIncome
JobLevel	0.95
TotalWorkingYears	0.78
YearsAtCompany	0.49
Age	0.48
YearsInCurrentRole	0.36
YearsWithCurrManager	0.33
YearsSinceLastPromotion	0.32

Then by some analyses, we can see that Monthly Income have a strong correlation with Job Level. Month Income, Total Working Years and Job Level are correlated strongly. These correlations are logical.

2. Analysis on Job Level

We have

Relationship	JobLevel
MonthlyIncome	0.95
TotalWorkingYears	0.78
YearsAtCompany	0.52
Age	0.48
YearsinCurrentRole	0.39
YearsWithCurrManager	0.37
YearsSinceLastPromotion	0.33

Then by some analyses, we can see that Job Level have a strong correlation with Monthly Income. Month Income, Total Working Years and Job Level are correlated strongly. These correlations are logical.

3. Analysis on Atrrition

By EDA1 - Analysis on each variable and by the correlation plot, we can see that some numerical variables have relationship with Attrition here (MonthlyIncome ~ TotalWorkingYears, JobLevel ~ TotalWorkingYears, YearsAtCompany ~ YearsinCurrentRole, YearsWithCurrManager ~ YearsinCurrentRole, YearsWithCurrManager ~ YearsAtCompany).

We will do another analysis in the next part to decide a good model.

VI. EDA4 - Automated EDA

1. Analysis on Monthly Income

Now I will use Automated EDA for Feature Selection. I use the library Boruta here to select important variables related to MonthlyIncome variable. (http://r-statistics.co/Variable-Selection-and-Importance-With-R.html)

boruta_output <- Boruta(MonthlyIncome ~ ., data=data2, doTrace=2)
boruta_signif <- names(boruta_output$finalDecision[boruta_output$finalDecision %in% c("Confirmed", "Tentative")])  # collect Confirmed and Tentative variables
print(boruta_signif)  # significant variables

##  [1] "Age"                     "Attrition"              
##  [3] "BusinessTravel"          "Department"             
##  [5] "Education"               "JobLevel"               
##  [7] "JobRole"                 "NumCompaniesWorked"     
##  [9] "TotalWorkingYears"       "YearsAtCompany"         
## [11] "YearsInCurrentRole"      "YearsSinceLastPromotion"
## [13] "YearsWithCurrManager"

plot(boruta_output, cex.axis=.7, las=2, xlab="", main="Variable Importance")

Then after running this code, I have 14 important variables as follows: Age, Attrition, BusinessTravel, Department, Education, JobLevel, JobRole, NumCompaniesWorked, TotalWorkingYears, YearsAtCompany, YearsInCurrentRole, YearsSinceLastPromotion, YearsWithCurrManager.

2. Analysis on Attrition

Similarly, I will run the following code

boruta_output <- Boruta(Attrition ~ ., data=rawdata0, doTrace=2)
boruta_signif <- names(boruta_output$finalDecision[boruta_output$finalDecision %in% c("Confirmed", "Tentative")])  # collect Confirmed and Tentative variables
print(boruta_signif)  # significant variables

##  [1] "Age"                  "Department"           "JobInvolvement"      
##  [4] "JobLevel"             "JobRole"              "JobSatisfaction"     
##  [7] "MaritalStatus"        "MonthlyIncome"        "NumCompaniesWorked"  
## [10] "OverTime"             "StockOptionLevel"     "TotalWorkingYears"   
## [13] "WorkLifeBalance"      "YearsAtCompany"       "YearsInCurrentRole"  
## [16] "YearsWithCurrManager"

plot(boruta_output, cex.axis=.7, las=2, xlab="", main="Variable Importance")

Then I will use important variable to build a model later: Age, Department, EnvironmentSatisfaction, JobInvolvement, JobLevel, JobRole, JobSatisfaction, MaritalStatus, MonthlyIncome, NumCompaniesWorked, OverTime, StockOptionLevel, TotalWorkingYears, WorkLifeBalance, YearsAtCompany, YearsInCurrentRole, YearsWithCurrManager.

VII. EDA5 - Multiple Linear Regression for Salary

Here we will use our EDA4 to build model for Monthly Income.

1. Build a Model

I will build a multiple linear regression on Monthly Income related to 14 important variables in the last part.

set.seed(100)
data3 <- select(rawdata, "MonthlyIncome", "Age", "Attrition", "BusinessTravel", "Department", "Education", "JobLevel", "JobRole", "NumCompaniesWorked", "TotalWorkingYears", "YearsAtCompany", "YearsInCurrentRole", "YearsSinceLastPromotion", "YearsWithCurrManager")
splitPerc1 = 0.8
trainIndices1 = sample(1:dim(data3)[1],round(splitPerc1 * dim(data3)[1]))
train1 = data3[trainIndices1,]
test1 = data3[-trainIndices1,]
lm1 = lm(MonthlyIncome ~ ., data = train1)
summary(lm1)

## 
## Call:
## lm(formula = MonthlyIncome ~ ., data = train1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3599.9  -618.2   -28.7   586.9  3976.5 
## 
## Coefficients:
##                                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      -460.4385   584.7780  -0.787 0.431341    
## Age                                -1.6469     6.3150  -0.261 0.794330    
## AttritionYes                      104.0117   117.0640   0.889 0.374588    
## BusinessTravelTravel_Frequently   191.2012   157.9819   1.210 0.226599    
## BusinessTravelTravel_Rarely       409.2843   135.5348   3.020 0.002625 ** 
## DepartmentResearch & Development  228.2193   474.6301   0.481 0.630789    
## DepartmentSales                  -351.1497   481.9957  -0.729 0.466541    
## Education                         -30.3332    41.4089  -0.733 0.464101    
## JobLevel                         2791.0173    93.4593  29.863  < 2e-16 ***
## JobRoleHuman Resources            -33.9349   558.5571  -0.061 0.951573    
## JobRoleLaboratory Technician     -676.1669   191.3353  -3.534 0.000437 ***
## JobRoleManager                   4328.4088   305.8894  14.150  < 2e-16 ***
## JobRoleManufacturing Director     180.1699   192.5615   0.936 0.349790    
## JobRoleResearch Director         4127.5414   247.1638  16.700  < 2e-16 ***
## JobRoleResearch Scientist        -355.1583   192.6310  -1.844 0.065663 .  
## JobRoleSales Executive            570.9446   391.4210   1.459 0.145129    
## JobRoleSales Representative        95.3766   431.1777   0.221 0.825004    
## NumCompaniesWorked                 -3.4078    18.8530  -0.181 0.856614    
## TotalWorkingYears                  49.3545    12.1666   4.057 5.56e-05 ***
## YearsAtCompany                      1.9822    15.2147   0.130 0.896380    
## YearsInCurrentRole                 -0.6587    18.5037  -0.036 0.971613    
## YearsSinceLastPromotion            30.7322    17.2900   1.777 0.075945 .  
## YearsWithCurrManager              -45.0684    18.8133  -2.396 0.016867 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1066 on 673 degrees of freedom
## Multiple R-squared:  0.9492, Adjusted R-squared:  0.9475 
## F-statistic: 571.4 on 22 and 673 DF,  p-value: < 2.2e-16

pred1 = predict(lm1, test1)
RMSE = sqrt(mean((test1$MonthlyIncome - pred1)^2))
RMSE

## [1] 1031.816

Then RMSE is around $1031.816.

2. Validation Requirement for Salary

Here I will use the file CaseStudy2CompSet No Salary.xlsx and create new dataframe case2nosalary1 with the same variables as the dataframe data3 in the last step (Build a Model) (without MonthlyIncome variable).

case2nosalary <- read_excel("CaseStudy2CompSet No Salary.xlsx")
case2nosalary1 <- select(case2nosalary, "Age", "Attrition", "BusinessTravel", "Department", "Education", "JobLevel", "JobRole", "NumCompaniesWorked", "TotalWorkingYears", "YearsAtCompany", "YearsInCurrentRole", "YearsSinceLastPromotion", "YearsWithCurrManager")

Now I will use the model built in the last step to predicting the salary for the file CaseStudy2CompSet No Salary.xlsx.

lm2 = lm(MonthlyIncome ~ ., data = data3)
pred2 = predict(lm2, case2nosalary1)


MonthlyIncome = pred2
MonthlyIncome = as.data.frame(MonthlyIncome)

case2nosalary2 = cbind(case2nosalary, MonthlyIncome)


write.csv(case2nosalary2, "Case2PredictionsNguyenSalary.csv", row.names = FALSE)

case2nosalary3 <- read.csv("Case2PredictionsNguyenSalary.csv", header = T)

head(case2nosalary3)

##    ID Age Attrition    BusinessTravel DailyRate             Department
## 1 871  43        No Travel_Frequently      1422                  Sales
## 2 872  33        No     Travel_Rarely       461 Research & Development
## 3 873  55       Yes     Travel_Rarely       267                  Sales
## 4 874  36        No        Non-Travel      1351 Research & Development
## 5 875  27        No     Travel_Rarely      1302 Research & Development
## 6 876  39       Yes     Travel_Rarely       895                  Sales
##   DistanceFromHome Education   EducationField EmployeeCount EmployeeNumber
## 1                2         4    Life Sciences             1           1849
## 2               13         1    Life Sciences             1            995
## 3               13         4        Marketing             1           1372
## 4                9         4    Life Sciences             1           1949
## 5               19         3            Other             1           1619
## 6                5         3 Technical Degree             1             42
##   EnvironmentSatisfaction Gender HourlyRate JobInvolvement JobLevel
## 1                       1   Male         92              3        2
## 2                       2 Female         53              3        1
## 3                       1   Male         85              4        4
## 4                       1   Male         66              4        1
## 5                       4   Male         67              2        1
## 6                       4   Male         56              3        2
##                 JobRole JobSatisfaction MaritalStatus MonthlyRate
## 1       Sales Executive               4       Married       19246
## 2    Research Scientist               4        Single       17241
## 3       Sales Executive               3        Single        9277
## 4 Laboratory Technician               2       Married        9238
## 5 Laboratory Technician               1      Divorced       16290
## 6  Sales Representative               4       Married        3335
##   NumCompaniesWorked Over18 OverTime PercentSalaryHike PerformanceRating
## 1                  1      Y       No                20                 4
## 2                  3      Y       No                18                 3
## 3                  6      Y      Yes                17                 3
## 4                  1      Y       No                22                 4
## 5                  1      Y       No                11                 3
## 6                  3      Y       No                14                 3
##   RelationshipSatisfaction StandardHours StockOptionLevel
## 1                        3            80                1
## 2                        1            80                0
## 3                        3            80                0
## 4                        2            80                0
## 5                        1            80                2
## 6                        3            80                1
##   TotalWorkingYears TrainingTimesLastYear WorkLifeBalance YearsAtCompany
## 1                 7                     5               3              7
## 2                 5                     4               3              3
## 3                24                     2               2             19
## 4                 5                     3               3              5
## 5                 7                     3               3              7
## 6                19                     6               4              1
##   YearsInCurrentRole YearsSinceLastPromotion YearsWithCurrManager
## 1                  7                       7                    7
## 2                  2                       0                    2
## 3                  7                       3                    8
## 4                  4                       0                    2
## 5                  7                       0                    7
## 6                  0                       0                    0
##   MonthlyIncome
## 1      5665.948
## 2      2730.876
## 3     12189.751
## 4      1954.560
## 5      2356.053
## 6      6102.791

Later, I will upload the preditecd file Case2PredictionsNguyenSalary.csv for Salary into github.

VIII. EDA6 - Naive Bayes classifiers for Attrition

Here I will use our EDA4 to build model for Attrition. I will use these vatiables: Age, Department, EnvironmentSatisfaction, JobInvolvement, JobLevel, JobRole, JobSatisfaction, MaritalStatus, MonthlyIncome, NumCompaniesWorked, OverTime, StockOptionLevel, TotalWorkingYears, WorkLifeBalance, YearsAtCompany, YearsInCurrentRole, YearsWithCurrManager.

1. Build a Model

I will use Naive Bayes classifiers to build a model here.

data4 <- select(rawdata, "Attrition", "Age", "Department",  "EnvironmentSatisfaction",  "JobInvolvement",  "JobLevel", "JobRole",  "JobSatisfaction", "MaritalStatus",  "MonthlyIncome", "NumCompaniesWorked",  "OverTime", "StockOptionLevel",  "TotalWorkingYears", "WorkLifeBalance", "YearsAtCompany", "YearsInCurrentRole", "YearsWithCurrManager")


set.seed(10000)
splitPercNB1 = 0.8
trainIndicesNB1 = sample(1:dim(data4)[1],round(splitPercNB1 * dim(data4)[1]))
trainNB1 = data4[trainIndicesNB1,]
testNB1 = data4[-trainIndicesNB1,]

NB1 <- naiveBayes(Attrition~.,data = trainNB1,laplace = -1)
predNB1 = predict(NB1, testNB1)

table(as.factor(testNB1$Attrition),predNB1)

##      predNB1
##        No Yes
##   No  125  26
##   Yes   8  15

#Confusion Matrix
confusion.Matrix = confusionMatrix(predNB1,as.factor(testNB1$Attrition))
confusion.Matrix

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  125   8
##        Yes  26  15
##                                           
##                Accuracy : 0.8046          
##                  95% CI : (0.7378, 0.8607)
##     No Information Rate : 0.8678          
##     P-Value [Acc > NIR] : 0.992836        
##                                           
##                   Kappa : 0.3604          
##                                           
##  Mcnemar's Test P-Value : 0.003551        
##                                           
##             Sensitivity : 0.8278          
##             Specificity : 0.6522          
##          Pos Pred Value : 0.9398          
##          Neg Pred Value : 0.3659          
##              Prevalence : 0.8678          
##          Detection Rate : 0.7184          
##    Detection Prevalence : 0.7644          
##       Balanced Accuracy : 0.7400          
##                                           
##        'Positive' Class : No              
## 

Sensitivity = confusion.Matrix$byClass['Sensitivity']
Specificity = confusion.Matrix$byClass['Specificity']
Accuracy = confusion.Matrix$overall['Accuracy']

Accuracy

##  Accuracy 
## 0.8045977

Sensitivity

## Sensitivity 
##   0.8278146

Specificity

## Specificity 
##   0.6521739

2. Validation Requirement for Attrition

Here I will use the file CaseStudy2CompSet No Attrition.csv and create new dataframe case2noattrition1 with the same variables as the dataframe data4 in the last step (Build a Model) (without Attrition variable).

case2noattrition <- read.csv("CaseStudy2CompSet No Attrition.csv")
case2noattrition1 <- select(case2noattrition, "Age", "Department",  "EnvironmentSatisfaction",  "JobInvolvement",  "JobLevel", "JobRole",  "JobSatisfaction", "MaritalStatus",  "MonthlyIncome", "NumCompaniesWorked",  "OverTime", "StockOptionLevel",  "TotalWorkingYears", "WorkLifeBalance", "YearsAtCompany", "YearsInCurrentRole", "YearsWithCurrManager")

Now I will use the model built in the last step to predicting Attrition for the file CaseStudy2CompSet No Attrition.csv.

set.seed(10000)

NB2 <- naiveBayes(Attrition~.,data = data4,laplace = -1)
predNB2 = predict(NB2, case2noattrition1)

## Warning in predict.naiveBayes(NB2, case2noattrition1): Type mismatch
## between training and new data for variable 'JobInvolvement'. Did you use
## factors with numeric labels for training, and numeric values for new data?

## Warning in predict.naiveBayes(NB2, case2noattrition1): Type mismatch
## between training and new data for variable 'JobSatisfaction'. Did you use
## factors with numeric labels for training, and numeric values for new data?

## Warning in predict.naiveBayes(NB2, case2noattrition1): Type mismatch
## between training and new data for variable 'WorkLifeBalance'. Did you use
## factors with numeric labels for training, and numeric values for new data?

Attrition = predNB2
Attrition = as.data.frame(Attrition)
case2noattrition2 = cbind(case2noattrition,Attrition)

write.csv(case2noattrition2,"Case2PredictionsNguyenAttrition.csv", row.names = FALSE)

case2noattrition3 <- read.csv("Case2PredictionsNguyenAttrition.csv", header = T)

head(case2noattrition3)

##     ID Age    BusinessTravel DailyRate             Department
## 1 1171  35     Travel_Rarely       750 Research & Development
## 2 1172  33     Travel_Rarely       147        Human Resources
## 3 1173  26     Travel_Rarely      1330 Research & Development
## 4 1174  55     Travel_Rarely      1311 Research & Development
## 5 1175  29     Travel_Rarely      1246                  Sales
## 6 1176  51 Travel_Frequently      1456 Research & Development
##   DistanceFromHome Education  EducationField EmployeeCount EmployeeNumber
## 1               28         3   Life Sciences             1           1596
## 2                2         3 Human Resources             1           1207
## 3               21         3         Medical             1           1107
## 4                2         3   Life Sciences             1            505
## 5               19         3   Life Sciences             1           1497
## 6                1         4         Medical             1            145
##   EnvironmentSatisfaction Gender HourlyRate JobInvolvement JobLevel
## 1                       2   Male         46              4        2
## 2                       2   Male         99              3        1
## 3                       1   Male         37              3        1
## 4                       3 Female         97              3        4
## 5                       3   Male         77              2        2
## 6                       1 Female         30              2        3
##                     JobRole JobSatisfaction MaritalStatus MonthlyIncome
## 1     Laboratory Technician               3       Married          3407
## 2           Human Resources               3       Married          3600
## 3     Laboratory Technician               3      Divorced          2377
## 4                   Manager               4        Single         16659
## 5           Sales Executive               3      Divorced          8620
## 6 Healthcare Representative               1        Single          7484
##   MonthlyRate NumCompaniesWorked Over18 OverTime PercentSalaryHike
## 1       25348                  1      Y       No                17
## 2        8429                  1      Y       No                13
## 3       19373                  1      Y       No                20
## 4       23258                  2      Y      Yes                13
## 5       23757                  1      Y       No                14
## 6       25796                  3      Y       No                20
##   PerformanceRating RelationshipSatisfaction StandardHours
## 1                 3                        4            80
## 2                 3                        4            80
## 3                 4                        3            80
## 4                 3                        3            80
## 5                 3                        3            80
## 6                 4                        3            80
##   StockOptionLevel TotalWorkingYears TrainingTimesLastYear WorkLifeBalance
## 1                2                10                     3               2
## 2                1                 5                     2               3
## 3                1                 1                     0               2
## 4                0                30                     2               3
## 5                2                10                     3               3
## 6                0                23                     1               2
##   YearsAtCompany YearsInCurrentRole YearsSinceLastPromotion
## 1             10                  9                       6
## 2              5                  4                       1
## 3              1                  1                       0
## 4              5                  4                       1
## 5             10                  7                       0
## 6             13                 12                      12
##   YearsWithCurrManager Attrition
## 1                    8       Yes
## 2                    4       Yes
## 3                    0       Yes
## 4                    2       Yes
## 5                    4       Yes
## 6                    8       Yes

Later, I will upload the preditecd file Case2PredictionsNguyenAttrition.csv for Salary into github.